home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Tools / Turbo Pascal V7 / TVFM.ZIP / TOOLS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-11-03  |  31KB  |  1,284 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision File Manager Demo               }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. unit Tools;
  9.  
  10. {$X+,V-}
  11.  
  12. interface
  13.  
  14. uses Drivers, Objects, Views, Dialogs, Memory, App, MsgBox,
  15.   Globals, FileCopy, Gauges, Dos;
  16.  
  17. type
  18.   String2 = String[2];
  19.   String4 = String[4];
  20.   TConfigHeader = String[24];
  21.  
  22.   { Used to display status messages }
  23.   PStatusBox = ^TStatusBox;
  24.   TStatusBox = object(TDialog)
  25.     procedure HandleEvent(var Event: TEvent); virtual;
  26.   end;
  27.  
  28.   { buffered file copy object }
  29.   PCopier = ^TCopier;
  30.   TCopier = object(TFileCopy)
  31.     procedure ReadMsg(const FName: FNameStr; Progress: Longint); virtual;
  32.     procedure WriteMsg(const FName: FNameStr; Progress: Longint); virtual;
  33.     function IOError(const FName: FNameStr; ECode:Integer) : erAction; virtual;
  34.   end;
  35.  
  36.   { generate a cmOK if double clicked }
  37.   POkListBox = ^TOkListBox;
  38.   TOkListBox = object(TListBox)
  39.     procedure SelectItem(Item: Integer); virtual;
  40.   end;
  41.  
  42. { ShowStatusBox displays a status dialog, using StatusMsg as the string }
  43. { to display. The status box responds to the cmStatusUpdate command by  }
  44. { redrawing the text.                                                   }
  45. procedure ShowStatusBox;
  46.  
  47. { KillStatusBox removes the status box from the screen }
  48. procedure KillStatusBox;
  49.  
  50. { Return True if the passed list contains any tagged files }
  51. function HasTaggedFiles(P: PFileList) : Boolean;
  52.  
  53. { Return the path and filename (no extension) of the exe }
  54. function GetExeBaseName: String;
  55.  
  56. { Convert strings to upper and lower case }
  57. procedure UpperCase(var s: String);
  58. procedure LowerCase(var s: String);
  59.  
  60. { Return a right justified number (in an 8 character field) }
  61. function RJustNum(L: Longint): String;
  62.  
  63. { Pad right end of string to Len bytes }
  64. function Pad(s: String; Len: Byte): String;
  65.  
  66. { Return a fully trimmed copy of Original }
  67. function FullTrim(const Original: String): String;
  68.  
  69. { Return string value of W, optionally with leading zero if Pad=True }
  70. function TwoDigit(W: Word; Pad: Boolean): String2;
  71.  
  72. { Return 4 digit string representation of W }
  73. function FourDigit(W: Word): String4;
  74.  
  75. { Return a string version of the Date/Time longint. Opts=$01 adds the }
  76. { date portion. Opts=$02 adds time, Opts=$03 adds both                }
  77. function FormatDateTime(DT: Longint; Opts: Word): String;
  78.  
  79. { Return the 4 character string representation of the attribute word }
  80. function FormatAttr(Attr: Word): String4;
  81.  
  82. { Return True if file is a .BAT, .COM, or .EXE }
  83. function IsExecutable(const FileName: FNameStr): Boolean;
  84.  
  85. { Execute the passed file, asks for parameters }
  86. procedure ExecuteFile(FileName: FNameStr);
  87.  
  88. { View passed file as Hex, Text, or with Custom Viewer }
  89. procedure ViewAsHex(const FileName: FNameStr);
  90. procedure ViewAsText(const FileName: FNameStr);
  91. procedure ViewCustom(const FileName: FNameStr);
  92.  
  93. { Return True if the passed drive letter is valid }
  94. function DriveValid(Drive: Char): Boolean;
  95.  
  96. { Return a selected drive letter from listbox of valid drives }
  97. function SelectDrive: Char;
  98.  
  99. { Invalidate the passed directory by issuing a cmInvalidDir broadcast }
  100. procedure InvalidateDir(Path: FNameStr);
  101.  
  102. { Copy either tagged or current file to a destination path }
  103. procedure HandleFileCopy(const Path: FNameStr; P: PFileList; Current: Integer);
  104.  
  105. { Delete file if user confirms the deletion, return error code }
  106. function SafeDelete(FileName: FNameStr): Integer;
  107.  
  108. { Handle deleting one or multiple files from a file list }
  109. procedure HandleFileDelete(const Path: FNameStr; List: PFileList;
  110.   Current: Integer);
  111.  
  112. { Present the Rename file dialog }
  113. procedure RenameFile(const Path: FNameStr; F: PFileRec);
  114.  
  115. { Present the Change Attribute dialog }
  116. procedure ChangeAttr(const Path: FNameStr; F:PFileRec);
  117.  
  118. { Allow user to specify what viewer program to use }
  119. procedure InstallViewer;
  120.  
  121. { Allow user to specify the display options }
  122. procedure SetDisplayPrefs;
  123.  
  124. { Save and load the configuration file }
  125. procedure SaveConfig;
  126. procedure ReadConfig;
  127.  
  128. { Execute the passed string literally }
  129. procedure RunDosCommand(Command: String);
  130.  
  131. { Return a TFileNameRec built from the passed filespec. This structure }
  132. { allows for easier comparisons by other procedures                    }
  133. function NewFileNameRec(const Path: FNameStr): PFileNameRec;
  134.  
  135. { Perform a drag & drop copy }
  136. procedure DragDropCopy(Mover: PFileMover; Dest: PathStr);
  137.  
  138. { return true if this name matches the wildcard }
  139. function WildCardMatch(const Name, Card: FNameStr): Boolean;
  140.  
  141. const
  142.   StatusMsg : String = '';
  143.  
  144. implementation
  145.  
  146. uses ViewHex, ViewText, Strings, Equ, Assoc;
  147.  
  148. const
  149.   StatusBox : PStatusBox = nil;
  150.   StatusPMsg : PString = @StatusMsg;
  151.  
  152.   ConfigHeader : TConfigHeader = 'TVFM Configuration File'#26;
  153.  
  154. { General utility procedures }
  155.  
  156. procedure ShowStatusBox;
  157. var
  158.   R: TRect;
  159.   P: PView;
  160. begin
  161.   if StatusBox <> nil then exit;
  162.   R.Assign(0,0,40,5);
  163.   StatusBox := New(PStatusBox, Init(R, 'Status'));
  164.   with StatusBox^ do
  165.   begin
  166.     Options := Options or ofCentered;
  167.     Options := Options and (not ofBuffered);
  168.     Flags := Flags and (not wfClose) and (not wfMove);
  169.     R.Assign(2,2,38,3);
  170.     P := New(PParamText, Init(R, ^C'%s', 1));
  171.     Insert(P);
  172.   end;
  173.   StatusMsg := '';
  174.   StatusPMsg := @StatusMsg;
  175.   StatusBox^.SetData(StatusPMsg);
  176.   Desktop^.Insert(StatusBox);
  177. end;
  178.  
  179. procedure ShowCopyStatusBox(MaxSize: Longint);
  180. var
  181.   R: TRect;
  182.   P: PView;
  183. begin
  184.   if StatusBox <> nil then exit;
  185.   R.Assign(0,0,40,7);
  186.   StatusBox := New(PStatusBox, Init(R, 'Status'));
  187.   with StatusBox^ do
  188.   begin
  189.     Options := Options or ofCentered;
  190.     Options := Options and (not ofBuffered);
  191.     Flags := Flags and (not wfClose) and (not wfMove);
  192.     R.Assign(2,2,38,3);
  193.     P := New(PParamText, Init(R, ^C'%s', 1));
  194.     Insert(P);
  195.     R.Assign(5,4,34,5);
  196.     Insert(New(PBarGauge, Init(R, MaxSize)));
  197.     R.Assign(2,4,4,5);
  198.     Insert(New(PStaticText, Init(R, '0%')));
  199.     R.Assign(35,4,39,5);
  200.     Insert(New(PStaticText, Init(R, '100%')));
  201.   end;
  202.   StatusMsg := '';
  203.   StatusPMsg := @StatusMsg;
  204.   StatusBox^.SetData(StatusPMsg);
  205.   Desktop^.Insert(StatusBox);
  206. end;
  207.  
  208. procedure KillStatusBox;
  209. begin
  210.   if StatusBox <> nil then
  211.   begin
  212.     Dispose(StatusBox, Done);
  213.     StatusBox := nil;
  214.   end;
  215. end;
  216.  
  217. { Return TRUE if the passed list has tagged files in it }
  218. function HasTaggedFiles(P: PFileList) : Boolean;
  219. var
  220.   Has: Boolean;
  221.   i: Integer;
  222. begin
  223.   Has := False;
  224.   i := 0;
  225.   while (i < P^.Count) and (not Has) do
  226.   begin
  227.     Has := PFileRec(P^.At(i))^.Tagged;
  228.     Inc(i);
  229.   end;
  230.   HasTaggedFiles := Has;
  231. end;
  232.  
  233. function GetExeBaseName : String;
  234. var
  235.   ExeFileName: FNameStr;
  236.   D: DirStr;
  237.   N: NameStr;
  238.   E: ExtStr;
  239. begin
  240.   ExeFileName := ParamStr(0);
  241.   if ExeFileName = '' then
  242.     ExeFileName := FSearch(EXEName, GetEnv('PATH'));
  243.   ExeFileName := FExpand(ExeFileName);
  244.   FSplit(ExeFileName, D, N, E);
  245.   GetExeBaseName := D + N;
  246. end;
  247.  
  248. procedure UpperCase(var s:string);
  249. var
  250.   i : Integer;
  251. begin
  252.   for i := 1 to Length(s) do
  253.     s[i] := Upcase(s[i]);
  254. end;
  255.  
  256. procedure LowerCase(var s:string);
  257. var
  258.   i : Integer;
  259. begin
  260.   for i := 1 to Length(s) do
  261.     if s[i] in ['A'..'Z'] then Inc(s[i], 32);
  262. end;
  263.  
  264. function RJustNum(L: Longint): String;
  265. var
  266.   s: String;
  267. begin
  268.   FormatStr(s, '%8d', L);
  269.   RJustNum := s;
  270. end;
  271.  
  272. function Pad(s: String; Len: Byte): String;
  273. begin
  274.   if Length(s) < Len then
  275.     FillChar(s[Succ(Length(s))], Len-Length(s), ' ');
  276.   s[0] := Char(Len);
  277.   Pad := s;
  278. end;
  279.  
  280. function FullTrim(const Original: String): String;
  281. var
  282.   S: String;
  283. begin
  284.   S := Original;
  285.   while (S[0] > #0) and (S[Length(S)] = #32) do Dec(S[0]);  { trim left }
  286.   while (S[0] > #0) and (S[1] = #32) do
  287.   begin
  288.     Move(S[2], S[1], Pred(Length(S)));
  289.     Dec(S[0]);
  290.   end;
  291.   FullTrim := S;
  292. end;
  293.  
  294. function TwoDigit(W: Word; Pad: Boolean) : String2;
  295. var
  296.   s: String2;
  297. begin
  298.   Str(W:2, s);
  299.   if Pad and (s[1] = ' ') then s[1] := '0';
  300.   TwoDigit := s;
  301. end;
  302.  
  303. function FourDigit(W: Word) : String4;
  304. var
  305.   s: String4;
  306. begin
  307.   Str(W:4, s);
  308.   FourDigit := s;
  309. end;
  310.  
  311. function FormatDateTime(DT: Longint; Opts: Word): String;
  312. var
  313.   s: String;
  314.   t: DateTime;
  315. begin
  316.   UnpackTime(DT, t);
  317.   s := '';
  318.   if (Opts and 1) <> 0 then  { add the date }
  319.   begin
  320.     s := s + TwoDigit(t.Month, False) + '-' + TwoDigit(t.Day, True);
  321.     s := s + '-' + Copy(FourDigit(t.Year),3,2);
  322.   end;
  323.   if (Opts and 2) <> 0 then  { add the time }
  324.   begin
  325.     if s <> '' then s := s + ' ';
  326.     s := s + TwoDigit(t.Hour, True) + ':' + TwoDigit(t.Min, True) + ':' +
  327.       TwoDigit(t.Sec, True);
  328.   end;
  329.   FormatDateTime := s;
  330. end;
  331.  
  332. function FormatAttr(Attr: Word): String4;
  333. var
  334.   s: String4;
  335. begin
  336.   s := '····';
  337.   if Attr and Archive = Archive then s[1] := 'A';
  338.   if Attr and ReadOnly = ReadOnly then s[2] := 'R';
  339.   if Attr and SysFile = SysFile then s[3] := 'S';
  340.   if Attr and Hidden = Hidden  then s[4] := 'H';
  341.   FormatAttr := s;
  342. end;
  343.  
  344. function IsExecutable(const FileName: FNameStr): Boolean;
  345. var
  346.   D: DirStr;
  347.   N: NameStr;
  348.   E: ExtStr;
  349. begin
  350.   FSplit(FExpand(FileName), D, N, E);
  351.   IsExecutable := (E = '.EXE') or (E = '.COM') or (E = '.BAT');
  352. end;
  353.  
  354. procedure ExecuteFile(FileName: FNameStr);
  355. var
  356.   D: PDialog;
  357.   R: TRect;
  358.   P: PView;
  359.   Dir: DirStr;
  360.   Name: FNameStr;
  361.   E: ExtStr;
  362.   Event: TEvent;
  363.   Params: string[80];
  364.   Command: string[80];
  365.   L: array[0..2] of Longint;
  366.   ParamPos: Integer;
  367.   Association: PAssociation;
  368. begin
  369.   FSplit(FExpand(FileName), Dir, Name, E);
  370.   Name := Name + E;
  371.   Association := nil;
  372.  
  373.   Command := '';
  374.   Params := '';
  375.   { Does an association exist for this file? }
  376.   if not IsExecutable(FileName) then
  377.   begin
  378.     Association := GetAssociatedCommand(E);
  379.     if Association <> nil then Command := Association^.Cmd^;
  380.     if Command = '' then
  381.     begin
  382.       L[0] := Longint(@FileName);
  383.       MessageBox(RezStrings^.Get(sNoAssociation), @L, mfError +
  384.         mfOKButton);
  385.       Exit;
  386.     end
  387.     else
  388.     begin
  389.       ParamPos := Pos(' ', Command);
  390.       if ParamPos > 0 then
  391.       begin
  392.         Params := Copy(Command, ParamPos + 1, $FF);
  393.         Delete(Command, ParamPos, $FF);
  394.         Params := Params + ' ' + FileName;
  395.       end
  396.       else
  397.         Params := FileName;
  398.     end;
  399.   end
  400.   else
  401.   begin
  402.     Command := FileName;
  403.     Params := '';
  404.   end;
  405.  
  406.   R.Assign(0,0,50,8);
  407.   D:= New(PDialog, Init(R, 'Execute Program'));
  408.   with D^ do
  409.   begin
  410.     Options := Options or ofCentered;
  411.     R.Assign(2,2,15,3);
  412.     Insert(New(PStaticText, Init(R, ' Executing:')));
  413.     R.Assign(15,2,48,3);
  414.     Insert(New(PStaticText, Init(R, Command)));
  415.  
  416.     R.Assign(15,3,48,4);
  417.     P := New(PInputLine, Init(R, 80));
  418.     Insert(P);
  419.     R.Assign(2,3,15,4);
  420.     Insert(New(PLabel, Init(R, '~P~arameters', P)));
  421.  
  422.     R.Assign(12,5,24,7);
  423.     Insert(New(PButton, Init(R, '~O~K', cmOK, bfDefault)));
  424.     R.Move(14,0);
  425.     Insert(New(PButton, Init(R, '~C~ancel', cmCancel, bfNormal)));
  426.     SelectNext(False);
  427.   end;
  428.  
  429.   if ( (Association <> nil) and (not Association^.Prompt)) or
  430.     (Application^.ExecuteDialog(D, @Params) = cmOK) then
  431.   begin
  432.     DoneSysError;
  433.     DoneEvents;
  434.     DoneVideo;
  435.     DoneDosMem;
  436.     SwapVectors;
  437.  
  438.     if E = '.BAT' then
  439.     begin
  440.       Command := GetEnv('COMSPEC');
  441.       Params := '/c ' + FileName + Params;
  442.     end;
  443.  
  444.     Exec(Command, Params);
  445.     SwapVectors;
  446.  
  447.     PrintStr(RezStrings^.Get(sPressAnyKey));
  448.     Event.What := evNothing;
  449.     repeat
  450.       GetKeyEvent(Event);
  451.     until Event.What <> evNothing;
  452.  
  453.     InitDosMem;
  454.     InitVideo;
  455.     InitEvents;
  456.     InitSysError;
  457.     Application^.Redraw;
  458.  
  459.     if DosError <> 0 then
  460.     begin
  461.       L[0] := DosError;
  462.       L[1] := Longint(@Command);
  463.       MessageBox(RezStrings^.Get(sExecErr), @L, mfError + mfOKButton);
  464.     end else
  465.     begin
  466.       L[0] := DosExitCode and $FF;
  467.       if L[0] <> 0 then
  468.         MessageBox(RezStrings^.Get(sExecRetCode), @L,
  469.           mfInformation + mfOKButton);
  470.     end;
  471.   end;
  472. end;
  473.  
  474. { view file procedures }
  475. procedure ViewAsHex(const FileName: FNameStr);
  476. var
  477.   H: PHexWindow;
  478.   R: TRect;
  479. begin
  480.   R.Assign(0,0,72,15);
  481.   H := New(PHexWindow, Init(R, FileName));
  482.   H^.Options := H^.Options or ofCentered;
  483.   Desktop^.Insert(H);
  484. end;
  485.  
  486. procedure ViewAsText(const FileName: FNameStr);
  487. var
  488.   T: PTextWindow;
  489.   R: TRect;
  490. begin
  491.   R.Assign(0,0,72,15);
  492.   T := New(PTextWindow, Init(R, FileName));
  493.   T^.Options := T^.Options or ofCentered;
  494.   Desktop^.Insert(T);
  495. end;
  496.  
  497. procedure ViewCustom(const FileName: FNameStr);
  498. var
  499.   Params : FNameStr;
  500.   Command : FNameStr;
  501.   D: DirStr;
  502.   N: NameStr;
  503.   E: ExtStr;
  504.   L : array[0..1] of Longint;
  505.   Msg: String;
  506.   PS: PString;
  507. begin
  508.   { create the program name }
  509.  
  510.   if FullTrim(Viewer) = '' then
  511.   begin
  512.     MessageBox(RezStrings^.Get(sNoViewerErr), nil, mfError + mfOKButton);
  513.     Exit;
  514.   end;
  515.  
  516.   FSplit(Viewer, D, N, E);
  517.  
  518.   DoneSysError;
  519.   DoneEvents;
  520.   DoneVideo;
  521.   DoneDosMem;
  522.   SwapVectors;
  523.  
  524.   if E = '.BAT' then
  525.   begin
  526.     Command := GetEnv('COMSPEC');
  527.     Params := '/c ' + Viewer + ' ' + FileName;
  528.   end
  529.   else
  530.   begin
  531.     Command := Viewer;
  532.     Params := FileName;
  533.   end;
  534.  
  535.   Exec(Command, Params);
  536.   SwapVectors;
  537.  
  538.   InitDosMem;
  539.   InitVideo;
  540.   InitEvents;
  541.   InitSysError;
  542.   Application^.Redraw;
  543.  
  544.   if DosError <> 0 then
  545.   begin
  546.     L[0] := DosError;
  547.     L[1] := Longint( @Viewer );
  548.     MessageBox(RezStrings^.Get(sInvokeErr), @L, mfError + mfOKButton);
  549.   end;
  550.  
  551. end;
  552.  
  553.  
  554. function DriveValid(Drive: Char): Boolean; assembler;
  555. asm
  556.     MOV    AH,19H          { Save the current drive in BL }
  557.         INT    21H
  558.         MOV    BL,AL
  559.      MOV    DL,Drive    { Select the given drive }
  560.         SUB    DL,'A'
  561.         MOV    AH,0EH
  562.         INT    21H
  563.         MOV    AH,19H        { Retrieve what DOS thinks is current }
  564.         INT    21H
  565.         MOV    CX,0        { Assume false }
  566.         CMP    AL,DL        { Is the current drive the given drive? }
  567.     JNE    @@1
  568.         MOV    CX,1        { It is, so the drive is valid }
  569.     MOV    DL,BL        { Restore the old drive }
  570.         MOV    AH,0EH
  571.         INT    21H
  572. @@1:    XCHG    AX,CX        { Put the return value into AX }
  573. end;
  574.  
  575. { Return a redirected device entry into the specified buffers }
  576. function GetRedirEntry(Entry: Word; Local, Net: Pointer): Boolean; assembler;
  577. asm
  578.         PUSH    DS
  579.         LDS     SI,Local
  580.         LES     DI,Net
  581.         MOV     AX,5F02h
  582.         MOV     BX,Entry
  583.         INT     21h
  584.         POP     DS
  585.         SBB     AL,AL
  586.         INC     AL
  587. end;
  588.  
  589. { return a list of redirected devices (drives only) }
  590. function RedirDeviceList: PDeviceCollection;
  591. var
  592.   List: PDeviceCollection;
  593.   Device: PDeviceRec;
  594.   P: PChar;
  595.   I: Word;
  596.   LocalName: array[0..15] of char;
  597.   NetworkName: array[0..127] of char;
  598. begin
  599.   List := nil;
  600.  
  601. {$IFNDEF DPMI}
  602.   List := New(PDeviceCollection, Init(10,10));
  603.   for I := 0 to 99 do
  604.   begin
  605.     if GetRedirEntry(I, @LocalName, @NetworkName) then
  606.     begin
  607.       if (LocalName[0] in ['D'..'Z']) and (LocalName[1] = ':') then
  608.       begin
  609.         New(Device);
  610.         Device^.LocalName := LocalName[0];
  611.         P := @NetworkName[2];
  612.         Device^.NetworkName := NewStr( StrPas(P) );
  613.         List^.Insert(Device);
  614.       end;
  615.     end
  616.     else Break;
  617.   end;
  618.  
  619.   if List^.Count = 0 then
  620.   begin
  621.     Dispose(List, Done);
  622.     List := nil;
  623.   end;
  624. {$ENDIF}
  625.  
  626.   RedirDeviceList := List;
  627. end;
  628.  
  629.  
  630. function ValidDriveList: PStringCollection;
  631. var
  632.   DriveList: PStringCollection;
  633.   DeviceList: PDeviceCollection;
  634.   Drive: Char;
  635.   Device: PDeviceRec;
  636.   S: String;
  637.  
  638.   function DriveMatch(P: PDeviceRec): Boolean; far;
  639.   begin
  640.     DriveMatch := Drive = P^.LocalName;
  641.   end;
  642.  
  643. begin
  644.   DriveList := New(PStringCollection, Init(26,0));
  645.   DeviceList := RedirDeviceList;
  646.   for Drive := 'A' to 'Z' do
  647.   begin
  648.     if DriveValid(Drive) then
  649.     begin
  650.       S := Drive + ':';
  651.       if DeviceList <> nil then
  652.       begin
  653.         Device := DeviceList^.FirstThat(@DriveMatch);
  654.         if Device <> nil then S := S + '  ' + Device^.NetworkName^;
  655.       end;
  656.       DriveList^.Insert(NewStr(S));
  657.     end;
  658.   end;
  659.   if DriveList^.Count = 0 then
  660.   begin
  661.     Dispose(DriveList, Done);
  662.     DriveList := nil;
  663.   end;
  664.   ValidDriveList := DriveList;
  665.   if DeviceList <> nil then Dispose(DeviceList, Done);
  666. end;
  667.  
  668. function SelectDrive : Char;
  669. var
  670.   R: TRect;
  671.   D: PDialog;
  672.   LB: PListBox;
  673.   SB: PScrollBar;
  674.   P: PString;
  675.   DriveList: PStringCollection;
  676.   CurDir: String;
  677.  
  678.   function IsCurrentDirectory(Dir: PString): Boolean; far;
  679.   begin
  680.     IsCurrentDirectory := Dir^[1] = CurDir[1];
  681.   end;
  682.  
  683. begin
  684.   GetDir(0, CurDir);  { save this value }
  685.   SelectDrive := ' ';
  686.   DriveList := ValidDriveList;
  687.  
  688.   if DriveList = nil then
  689.   begin
  690.     MessageBox(RezStrings^.Get(sNoDrivesErr), nil, mfError + mfOKButton);
  691.     Exit;
  692.   end;
  693.  
  694.   R.Assign(0, 0, 53, 13);
  695.   D := New(PDialog, Init(R, 'Select Drive'));
  696.   with D^ do
  697.   begin
  698.     Options := Options or ofCentered;
  699.     R.Assign(50, 3, 51, 9);
  700.     SB := New(PScrollBar, Init(R));
  701.     Insert(SB);
  702.     R.Assign(2, 3, 50, 9);
  703.     LB := New(POkListBox, Init(R, 1, SB));
  704.     Insert(LB);
  705.     LB^.NewList(DriveList);
  706.     R.Assign(2, 2, 19, 3);
  707.     Insert(New(PLabel, Init(R, '~D~rives', LB)));
  708.     R.Assign(12, 10, 24, 12);
  709.     Insert(New(PButton, Init(R, '~O~K', cmOK, bfDefault)));
  710.     R.Move(16, 0);
  711.     Insert(New(PButton, Init(R, '~C~ancel', cmCancel, bfNormal)));
  712.     SelectNext(False);
  713.   end;
  714.  
  715.   P := DriveList^.FirstThat(@IsCurrentDirectory);
  716.   if P <> nil then
  717.     LB^.FocusItem(DriveList^.IndexOf(P));
  718.  
  719.   if Desktop^.ExecView(D) = cmOK then
  720.   begin
  721.     P := DriveList^.At(LB^.Focused);
  722.     if P <> nil then SelectDrive := P^[1];
  723.   end;
  724.   Dispose(DriveList, Done);
  725.   Dispose(D, Done);
  726. end;
  727.  
  728. procedure InvalidateDir(Path: FNameStr);
  729. begin
  730.   Message(Desktop, evBroadcast, cmInvalidDir, @Path);
  731. end;
  732.  
  733. procedure HandleFileCopy(const Path: FNameStr; P: PFileList; Current: Integer);
  734. var
  735.   Dest, S, D: string[80];
  736.   C: TCopier;
  737.   Dlg: PDialog;
  738.   TotalSize: Longint;
  739.  
  740.   procedure CopyTagged(F: PFileRec); far;
  741.   begin
  742.     if F^.Tagged then
  743.     begin
  744.       S := Path + '\' + F^.Name + F^.Ext;
  745.       D := Dest + F^.Name + F^.Ext;
  746.       C.CopyFile(S, D, coNormal);
  747.     end;
  748.   end;
  749.  
  750.   procedure AddSizes(F: PFileRec); far;
  751.   begin
  752.     if F^.Tagged then Inc(TotalSize, F^.Size);
  753.   end;
  754.  
  755.   procedure CopySingle(F: PFileRec);
  756.   begin
  757.     S := Path + '\' + F^.Name + F^.Ext;
  758.     D := Dest + F^.Name + F^.Ext;
  759.     C.CopyFile(S, D, coNormal);
  760.   end;
  761.  
  762. begin
  763.   Dest := '';
  764.   Dlg := PDialog( RezFile.Get('CopyDialog') );
  765.   Application^.ExecuteDialog(Dlg, @Dest);
  766.   if Dest = '' then Exit;
  767.  
  768.   Dest := FExpand(Dest);
  769.   if (Dest[Length(Dest)] <> '\') and (Dest[Length(Dest)] <> ':') then
  770.     Dest := Dest + '\';
  771.  
  772.   C.Init(20);
  773.  
  774.   TotalSize := 0;
  775.   if HasTaggedFiles(P) then P^.ForEach(@AddSizes)
  776.   else TotalSize := PFileRec(P^.At(Current))^.Size;
  777.   ShowCopyStatusBox(TotalSize);
  778.  
  779.   if HasTaggedFiles(P) then P^.ForEach(@CopyTagged)
  780.   else CopySingle( PFileRec( P^.At(Current) ) );
  781.  
  782.   C.Done;
  783.   KillStatusBox;
  784.  
  785.   if Dest[Length(Dest)] = '\' then Dec(Dest[0]);
  786.   InvalidateDir(Dest);
  787. end;
  788.  
  789. function SafeDelete(FileName: FNameStr): Integer;
  790. var
  791.   R: Word;
  792.   F: File;
  793.   C: Word;
  794.   L: Longint;
  795.   D: PDialog;
  796.   Params: array[0..1] of Pointer;
  797.   Name : FNameStr;
  798.   Msg : String;
  799.   Attr: Word;
  800. begin
  801.   SafeDelete := -1;
  802.   C := cmYes; { default value }
  803.   Assign(F, FileName);
  804.   GetFAttr(F, Attr);
  805.   if DosError <> 0 then
  806.   begin
  807.     Params[0] := Pointer(L);
  808.     Params[1] := @FileName;
  809.     MessageBox(RezStrings^.Get(sAccessErr), @Params, mfError + mfOKButton);
  810.     SafeDelete := L;
  811.     Exit;
  812.   end;
  813.  
  814.   if (Attr and ReadOnly) <> 0 then Msg := RezStrings^.Get(sFileIsReadOnly)
  815.   else Msg := '';
  816.   Params[0] := @FileName;
  817.   Params[1] := @Msg;
  818.  
  819.   if ConfirmDelete then
  820.   begin
  821.     D := PDialog( RezFile.Get('ConfirmDelete') );
  822.     C := Application^.ExecuteDialog(D, @Params);
  823.   end;
  824.  
  825.   if C = cmYes then
  826.   begin
  827.     { if file was read-only, clear that attribute }
  828.     if (Attr and ReadOnly) <> 0 then
  829.     begin
  830.       SetFAttr(F, Attr and (not ReadOnly));
  831.       if DosError <> 0 then
  832.       begin
  833.         L := DosError;
  834.         Params[0] := @Msg;
  835.         Params[1] := Pointer(L);
  836.         MessageBox(RezStrings^.Get(sSetAttrErr), @Params, mfError+mfOKButton);
  837.         SafeDelete := DosError;
  838.         Exit;
  839.       end;
  840.     end;
  841.  
  842.     { delete the file }
  843.     {$I-}
  844.     Erase(F);
  845.     {$I+}
  846.     L := IOResult;
  847.     if L <> 0 then
  848.     begin
  849.       Params[0] := @Msg;
  850.       Params[1] := Pointer(L);
  851.       MessageBox(RezStrings^.Get(sDeleteErr), @Params, mfError+mfOKButton);
  852.       SafeDelete := L;
  853.       Exit;
  854.     end
  855.     else
  856.       SafeDelete := 0;
  857.   end;
  858. end;
  859.  
  860. function RemoveDeadFiles(P: PFileList): Integer;
  861. var
  862.   F : PFileRec;
  863.   i : Integer;
  864.   Count: Integer;
  865. begin
  866.   Count := 0;
  867.   i := 0;
  868.   while i < P^.Count do
  869.   begin
  870.     F := P^.At(i);
  871.     if F^.Name[1] = #0 then
  872.     begin
  873.       if F^.Tagged then
  874.       begin
  875.         F^.Toggle;
  876.         Message(Desktop, evBroadcast, cmTagChanged, F);
  877.       end;
  878.       Inc(Count);
  879.       P^.AtFree(i);
  880.     end
  881.     else inc(i);
  882.   end;
  883.   RemoveDeadFiles := Count;
  884. end;
  885.  
  886. function DeleteMultFiles(Path: FNameStr; List: PFileList): Boolean;
  887. var
  888.   F: PFileRec;
  889.   N: FNameStr;
  890.  
  891.   procedure DeleteIfTagged(F: PFileRec); far;
  892.   begin
  893.     if F^.Tagged then
  894.     begin
  895.       N := Path + '\' + F^.Name + F^.Ext;
  896.       StatusMsg := RezStrings^.Get(sDeleting) + N;
  897.       Message(StatusBox, evBroadcast, cmStatusUpdate, nil);
  898.       if SafeDelete(N) = 0 then F^.Name[1] := #0;  { mark as deleted }
  899.     end;
  900.   end;
  901.  
  902. begin
  903.   ConfirmDelete := False;
  904.  
  905.   StatusMsg := '';
  906.   ShowStatusBox;
  907.   List^.ForEach(@DeleteIfTagged);
  908.   KillStatusBox;
  909.  
  910.   DeleteMultFiles := RemoveDeadFiles(List) > 0;
  911.  
  912.   ConfirmDelete := True;
  913. end;
  914.  
  915. procedure HandleFileDelete(const Path: FNameStr; List: PFileList;
  916.   Current: Integer);
  917. var
  918.   D: PDialog;
  919.   Command: Word;
  920.   F: PFileRec;
  921. begin
  922.  
  923.   F := List^.At(Current);
  924.   Command := cmNo;  { default to only deleting current file }
  925.  
  926.   if HasTaggedFiles(List) then
  927.   begin
  928.     D := PDialog( RezFile.Get('DeleteWhich') );
  929.     Command := Application^.ExecuteDialog(D, nil);
  930.   end;
  931.  
  932.   if Command = cmNo then  { only delete the current file }
  933.   begin
  934.     F := List^.At(Current);
  935.     if SafeDelete(Path + '\' + F^.Name + F^.Ext) = 0 then
  936.       InvalidateDir(Path);
  937.   end
  938.   else if Command = cmYes then   { delete all marked files }
  939.   begin
  940.     if DeleteMultFiles(Path, List) then
  941.       InvalidateDir(Path);
  942.   end;
  943.  
  944. end;
  945.  
  946. procedure RenameFile(const Path: FNameStr; F: PFileRec);
  947. var
  948.   D: PRenameDialog;
  949.   Dir: DirStr;
  950.   N: NameStr;
  951.   E: ExtStr;
  952. begin
  953.   D := New(PRenameDialog, Init(Path + '\' + F^.Name + F^.Ext));
  954.   if D <> nil then
  955.   begin
  956.     if Application^.ExecuteDialog(D, nil) = cmOK then
  957.     begin
  958.       FSplit(D^.NewName, Dir, N, E);
  959.       F^.Name := N;
  960.       F^.Ext := E;
  961.       InvalidateDir(Path);
  962.     end;
  963.   end;
  964. end;
  965.  
  966. procedure ChangeAttr(const Path: FNameStr; F: PFileRec);
  967. var
  968.   D: PAttrDialog;
  969. begin
  970.   D := New(PAttrDialog, Init(Path + '\' + F^.Name + F^.Ext));
  971.   if D <> nil then
  972.   begin
  973.     if Application^.ExecuteDialog(D, nil) = cmOK then
  974.     begin
  975.       F^.Attr := D^.NewAttr;
  976.       InvalidateDir(Path);
  977.     end;
  978.   end
  979.   else
  980.     MessageBox(RezStrings^.Get(sReadAttrErr), nil,
  981.       mfError + mfOKButton);
  982. end;
  983.  
  984. procedure InstallViewer;
  985. var
  986.   VPath: FNameStr;
  987.   Valid, Done: Boolean;
  988.   L: Longint;
  989. begin
  990.   VPath := Viewer;
  991.   Valid := False;
  992.   Done := False;
  993.   while (not Valid) and (not Done) do
  994.   begin
  995.     if InputBox(RezStrings^.Get(sCustomViewer), RezStrings^.Get(sPathAndName),
  996.       VPath, SizeOf(FNameStr) - 1) = cmOK then
  997.     begin
  998.       UpperCase(VPath);
  999.       VPath := FSearch(VPath, GetEnv('PATH'));
  1000.       if VPath = '' then
  1001.       begin
  1002.         MessageBox(RezStrings^.Get(sCantLocateOnPath), nil,
  1003.           mfError + mfOKButton);
  1004.       end
  1005.       else if not IsExecutable(VPath) then
  1006.       begin
  1007.         L := Longint(@VPath);
  1008.         MessageBox(RezStrings^.Get(sFileNotAnExe), @L, mfError+mfOKButton);
  1009.       end
  1010.       else Valid := True;
  1011.     end
  1012.     else Done := True;
  1013.   end;
  1014.   if Valid then Viewer := VPath;
  1015. end;
  1016.  
  1017. procedure SetDisplayPrefs;
  1018. var
  1019.   D: PDialog;
  1020.   SaveMask: string[12];
  1021. begin
  1022.   D := PDialog( RezFile.Get('DisplayPref') );
  1023.  
  1024.   SaveMask := ConfigRec.FileMask;
  1025.   if Application^.ExecuteDialog(D, @ConfigRec) = cmOK then
  1026.   begin
  1027.     Uppercase(ConfigRec.FileMask);
  1028.  
  1029.     if ConfigRec.ShowHidden > 0 then
  1030.       UnwantedFiles := VolumeID or Directory
  1031.     else
  1032.       UnwantedFiles := VolumeID or Directory or SysFile or Hidden;
  1033.  
  1034.     if ConfigRec.FileMask <> SaveMask then
  1035.       Message(Desktop, evBroadcast, cmRescan, nil)
  1036.     else
  1037.       Message(Desktop, evBroadcast, cmRefreshDisplay, nil);
  1038.   end;
  1039. end;
  1040.  
  1041. procedure SaveConfig;
  1042. var
  1043.   Result: Longint;
  1044.   F: PDosStream;
  1045.   Pal: PString;
  1046. begin
  1047.   F := New(PDosStream, Init(GetExeBaseName + CFGExt, stCreate));
  1048.   Result := F^.Status;
  1049.   if Result <> 0 then
  1050.   begin
  1051.     MessageBox(RezStrings^.Get(sWriteCfgErr), @Result, mfError+mfOKButton);
  1052.     Exit;
  1053.   end;
  1054.   F^.Write(ConfigHeader[1], SizeOf(TConfigHeader) - 1);
  1055.   F^.Write(ConfigRec, SizeOf(TConfigRec));
  1056.   F^.Write(Viewer, SizeOf(FNameStr));
  1057.   Pal := @Application^.GetPalette^;
  1058.   F^.WriteStr(Pal);
  1059.   WriteAssociationList(F^);
  1060.   Dispose(F, Done);
  1061. end;
  1062.  
  1063. procedure ReadConfig;
  1064. var
  1065.   Result: Longint;
  1066.   F: PDosStream;
  1067.   Header: TConfigHeader;
  1068.   Pal: PString;
  1069. begin
  1070.   F := New(PDosStream, Init(GetExeBaseName + CFGExt, stOpenRead));
  1071.   Result := F^.Status;
  1072.   if Result <> 0 then Exit;
  1073.   F^.Read(Header[1], SizeOf(TConfigHeader) - 1);
  1074.   Header[0] := Char( SizeOf(TConfigHeader) -1 );
  1075.   if Header <> ConfigHeader then
  1076.   begin
  1077.     MessageBox(RezStrings^.Get(sInvalidCfgErr), nil, mfError + mfOKButton);
  1078.     Exit;
  1079.   end;
  1080.   F^.Read(ConfigRec, SizeOf(TConfigRec));
  1081.   F^.Read(Viewer, SizeOf(FNameStr));
  1082.   Pal := F^.ReadStr;
  1083.   if Pal <> nil then
  1084.   begin
  1085.     Application^.GetPalette^ := Pal^;
  1086.     DoneMemory;
  1087.     Application^.ReDraw;
  1088.     DisposeStr(Pal);
  1089.   end;
  1090.   ReadAssociationList(F^);
  1091.   Dispose(F, Done);
  1092. end;
  1093.  
  1094. procedure RunDosCommand(Command: String);
  1095. var
  1096.   D: PDialog;
  1097.   Event: TEvent;
  1098. begin
  1099.   D := PDialog( RezFile.Get('RunDialog') );
  1100.   if (Application^.ExecuteDialog(D, @Command) = cmOK) and
  1101.      (FullTrim(Command) <> '') then
  1102.   begin
  1103.     DoneSysError;
  1104.     DoneEvents;
  1105.     DoneVideo;
  1106.     DoneDosMem;
  1107.  
  1108.     SwapVectors;
  1109.     Exec(GetEnv('COMSPEC'), '/C' + Command);
  1110.     SwapVectors;
  1111.  
  1112.     PrintStr(RezStrings^.Get(sPressAnyKey));
  1113.     repeat
  1114.       GetKeyEvent(Event);
  1115.     until Event.What <> evNothing;
  1116.  
  1117.     InitDosMem;
  1118.     InitVideo;
  1119.     InitEvents;
  1120.     InitSysError;
  1121.  
  1122.     Application^.Redraw;
  1123.   end;
  1124. end;
  1125.  
  1126. function NewFileNameRec(const Path: FNameStr): PFileNameRec;
  1127. var
  1128.   D: DirStr;
  1129.   N: NameStr;
  1130.   E: ExtStr;
  1131.   P: PFileNameRec;
  1132. begin
  1133.   FSplit(Path, D, N, E);
  1134.   New(P);
  1135.   P^.Dir := D;
  1136.   P^.Name := N;
  1137.   P^.Ext := E;
  1138.   NewFileNameRec := P;
  1139. end;
  1140.  
  1141. procedure DragDropCopy(Mover: PFileMover; Dest: PathStr);
  1142. var
  1143.   C: TCopier;
  1144.   TotalSize: Longint;
  1145.  
  1146.   procedure AddSizes(F: PFileRec); far;
  1147.   begin
  1148.     Inc(TotalSize, F^.Size);
  1149.   end;
  1150.  
  1151.   procedure CopyFiles(F: PFileRec); far;
  1152.   begin
  1153.     C.CopyFile(Mover^.Dir + '\' + F^.Name + F^.Ext,
  1154.       Dest + '\' + F^.Name + F^.Ext, coNormal);
  1155.   end;
  1156.  
  1157. begin
  1158.   if Mover^.Dir = Dest then
  1159.   begin
  1160.     MessageBox('Files cannot be copied to same directory.',nil,
  1161.       mfError + mfOKButton);
  1162.     Exit;
  1163.   end;
  1164.  
  1165.   if MessageBox('Copy files to ' + Dest, nil, mfConfirmation +
  1166.     mfOKCancel) <> cmOK then Exit;
  1167.  
  1168.   C.Init(20);
  1169.   TotalSize := 0;
  1170.   Mover^.Items^.ForEach(@AddSizes);
  1171.  
  1172.   ShowCopyStatusBox(TotalSize);
  1173.   Mover^.Items^.ForEach(@CopyFiles);
  1174.  
  1175.   C.Done;
  1176.   KillStatusBox;
  1177.  
  1178.   InvalidateDir(Dest);
  1179. end;
  1180.  
  1181. function WildCardMatch(const Name, Card: FNameStr): Boolean;
  1182. var
  1183.   I, J: Integer;
  1184. begin
  1185.   WildCardMatch := False;
  1186.   J := 1;
  1187.   I := 1;
  1188.   while J <= Length(Card) do
  1189.     case Card[J] of
  1190.       '*':
  1191.         begin
  1192.           while (J <= Length(Card)) and (Card[J] <> '.') do Inc(J);
  1193.           while (I <= Length(Name)) and (Name[I] <> '.') do Inc(I);
  1194.         end;
  1195.       '?':
  1196.         begin
  1197.           Inc(J);
  1198.           Inc(I);
  1199.         end;
  1200.       '.':
  1201.         begin
  1202.           if I <= Length(Name) then
  1203.             if Name[I] <> '.' then
  1204.               Exit
  1205.             else
  1206.               Inc(I);
  1207.           Inc(J);
  1208.         end;
  1209.     else
  1210.       if (I > Length(Name)) or (Card[J] <> Name[I]) then Exit;
  1211.       Inc(I);
  1212.       Inc(J);
  1213.     end;
  1214.   WildCardMatch := (I > Length(Name)) and (J > Length(Card));
  1215. end;
  1216.  
  1217. { TStatusBox }
  1218. procedure TStatusBox.HandleEvent(var Event:TEvent);
  1219. begin
  1220.   inherited HandleEvent(Event);
  1221.   if (Event.What=evBroadcast) and (Event.Command = cmStatusUpdate) then
  1222.     DrawView;
  1223. end;
  1224.  
  1225.  
  1226. { TCopier }
  1227. procedure TCopier.ReadMsg(const FName: FNameStr; Progress: Longint);
  1228. begin
  1229.   StatusMsg := RezStrings^.Get(sReading) + FName;
  1230.   Message(StatusBox, evBroadcast, cmStatusUpdate, nil);
  1231.   Message(StatusBox, evBroadcast, cmAddGauge, Pointer(Progress div 2));
  1232. end;
  1233.  
  1234. procedure TCopier.WriteMsg(const FName: FNameStr; Progress: Longint);
  1235. begin
  1236.   StatusMsg := RezStrings^.Get(sWriting) + FName;
  1237.   Message(StatusBox, evBroadcast, cmStatusUpdate, nil);
  1238.   Message(StatusBox, evBroadcast, cmAddGauge, Pointer(Progress div 2));
  1239. end;
  1240.  
  1241. function TCopier.IOError(const FName: FNameStr; ECode: Integer) : erAction;
  1242. var
  1243.   Msg: String;
  1244.   D: PDialog;
  1245.   R: TRect;
  1246.   P: PView;
  1247. begin
  1248.   Msg := ErrorMsg(ECode);
  1249.  
  1250.   R.Assign(0,0,55,7);
  1251.   D := New(PDialog, Init(R, FName));
  1252.   with D^ do
  1253.   begin
  1254.     Options := Options or ofCentered;
  1255.     R.Assign(2,2,52,3);
  1256.     Insert(New(PStaticText, Init(R, Msg)));
  1257.     R.Assign(20,4,32,6);
  1258.     Insert(New(PButton, Init(R, '~R~etry', cmOK, bfDefault)));
  1259.     R.Move(14,0);
  1260.     Insert(New(PButton, Init(R, '~A~bort', cmCancel, bfNormal)));
  1261.     SelectNext(False);
  1262.   end;
  1263.   if Application^.ExecuteDialog(D, nil) = cmOK then IOError := erRetry
  1264.   else IOError := erAbort;
  1265. end;
  1266.  
  1267. { TOkListBox }
  1268.  
  1269. procedure TOkListBox.SelectItem(Item: Integer);
  1270. var
  1271.   E: TEvent;
  1272. begin
  1273.   inherited SelectItem(Item);
  1274.   with E do
  1275.   begin
  1276.     What := evCommand;
  1277.     Command := cmOk;
  1278.     InfoPtr := nil;
  1279.   end;
  1280.   PutEvent(E);
  1281. end;
  1282.  
  1283. end.
  1284.